Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11sub.mac < prev next >

Wrap

Text File | 1989-06-12 | 18.4 KB | 752 lines

.title k11sub common subroutines for all execs .ident /8.0.01/ ; Brian Nelson 01-Dec-83 13:19:14 ; ; Copyright (C) 1983 Change Software, Inc. ; ; ; This software is furnished under a license and may ; be used and copied only in accordance with the ; terms of such license and with the inclusion of ; the above copyright notice. This software or any ; other copies thereof may not be provided or other- ; wise made available to any other person. No title ; to and ownership of the software is hereby trans- ; ferred. ; ; The information in this software is subject to ; change without notice and should not be construed ; as a commitment by the author. ; define macros and things we want for KERMIT-11 .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed .psect $code .enabl gbl .sbttl cvt$$ basic+ cvt$$ function .enabl lsb ; calls cvt$$ ,<addr(input),len(input),val(cvtbitpattern)> ; ; returns @ addr(input) trimmed string ; r0 length of whats left ; ; MASK TRIMS ; ---- ----- ; ; 1 DISCARD ALL PARITY BITS ; 2 DISCARD ALL SPACES & TABS ; 4 DISCARD CR LF FF ESC RO ; 10 DISCARD LEADING SPACES & TABS ; 20 REDUCE SPACES & TABS TO A SINGLE SPACE ; 40 CONVERT LC TO UC ; 100 CONVERT [ TO ( AND ] TO ) ; 200 DISCARD TRAILING SPACES & TABS ; 400 PRESERVE QUOTED SUBSTRINGS ; 1000 MODIFY 4 (IF ON) TO DISCARD ALL CHARACTERS < 40 OR =177 ; c.par = 1 c.spac = 2 c.crlf = 4 c.lspa = 10 c.sspa = 20 c.lcuc = 40 c.brac = 100 c.tspa = 200 c.quot = 400 c.prt = 1000 .asect . = 0 pat: .blkw 1 inquo: .blkw 1 lastch: .blkw 1 saddr: .blkw 1 lsize = . + 2 .psect .psect $code .sbttl the real work of cvt$$ edit$:: cvt$$:: save <r1,r2,r3,r4,r5> ; the scratch registers to use. sub #lsize ,sp ; allocate some work space mov sp ,r4 ; point to a local work area mov (r5)+ ,r2 ; the string address for output mov r2 ,saddr(r4) ; and save it for a while mov (r5)+ ,r1 ; get the string length also. mov (r5)+ ,pat(r4) ; and finally the bit pattern. clr inquo(r4) ; assume not in a quoted string. clrb lastch(r4) ; no previous character please. mov r2 ,r5 ; where to get the input string tst r1 ; the length beq 130$ ; nothing to do 10$: clr r3 ; avoind the movb sxt please. bisb (r5)+ ,r3 ; get the next character . tstb inquo(r4) ; currently in quoted string? bne usech ; yes, skip all this junk. bit #c.par ,pat(r4) ; Do we trim off the parity ? beq 20$ bicb #200 ,r3 ; yes. clear bit number 7 20$: bit #c.spac!c.lspa,pat(r4) ; How about removing spaces & bne 25$ ; tabs. if ne, yes bit #c.sspa ,pat(r4) ; reduce imbedded ones to beq 30$ ; a single tab/space ? cmpb r3 ,#11 ; yes. if ch eq tab, then make bne 21$ ; it into a space first please. movb #40 ,r3 ; simple 21$: cmpb lastch(r4),#40 ; yes, was the last ch a space beq 25$ ; or a tab ? cmpb lastch(r4),#11 ; please check both out bne 30$ ; no 25$: cmpb r3 ,#40 ; is the current character a beq skipch ; space ? cmpb r3 ,#9. ; not a space. try a horz tab beq skipch ; char was a tab. Then ignore. bic #c.lspa ,pat(r4) ; For leading spaces and tabs. 30$: bit #c.crlf ,pat(r4) ; try for ignoring form feed, beq 50$ ; car ret,line feed,esc,null. mov #junkch ,r0 ; Get the address of the spec tstb r3 ; is the current ch a null ? beq skipch ; yes, please skip it then. 40$: tstb @r0 ; anything left in the list ? beq 50$ ; no cmpb r3 ,(r0)+ ; see if we have a match. If beq skipch ; so, we will skip the char. br 40$ ; no, next check please 50$: bit #c.lcuc ,pat(r4) ; how about converting lower beq 60$ ; case to upper case ? cmpb r3 ,#'z!40 ; try against a lower case Z bhi 60$ cmpb r3 ,#'a!40 ; if less than a lower z,try blo 60$ ; for ge a lower case a bicb #40 ,r3 ; char is in range. translate 60$: bit #c.brac ,pat(r4) ; how about convert [ to ( and beq usech ; and convert ] to ) cmpb r3 ,#'[ ; and so on bne 70$ movb #'( ,r3 ; convert it. fall thru to next 70$: cmpb r3 ,#'] bne usech movb #') ,r3 br usech skipch: br 120$ ; do not want the char, skip it. .sbttl got a good ch, check for quoted string things usech: bit #c.quot ,pat(r4) ; what about leaving quoted beq 110$ ; strings alone ? tstb inquo(r4) ; currently in a quoted string? bne 90$ ; yes, check for the stopper. cmpb r3 ,#'' ; a quote here ? beq 80$ ; yes cmpb r3 ,#'" ; alternate for a quote bne 90$ ; no 80$: movb r3 ,inquo(r4) ; yes, save the terminator br 110$ ; next please 90$: cmpb r3 ,inquo(r4) ; yes, is this the end of a bne 110$ ; quoted string ? clrb inquo(r4) ; yes, turn the flag off then. 110$: bit #c.prt ,pat(r4) ; should we skip nonprintable beq 115$ ; characters now ? cmpb r3 ,#40 ; yes, less than a space blo 120$ ; yes tstb r3 ; greater than 177 (rubout) bmi 120$ ; yes 115$: movb r3 ,(r2)+ ; if all ok, return the char. 120$: movb r3 ,lastch(r4) ; please save the last ch dec r1 ; and go back for some more. bgt 10$ ; next please 130$: mov r2 ,r0 ; current pointer sub saddr(r4),r0 ; return the length of what's ble 160$ ; nothing left to do then. bit #c.tspa ,pat(r4) ; remove trailing blanks ? beq 160$ ; no mov saddr(r4),r1 ; address of the string. add r0 ,r1 ; point to end of string+1. 140$: cmpb -(r1) ,#40 ; Try for a space first. beq 150$ cmpb (r1) ,#9. ; Not a space, try a tab. bne 160$ 150$: sob r0 ,140$ ; Tab or space. Check next 160$: 170$: add #lsize ,sp ; pop small work area unsave <r5,r4,r3,r2,r1> ; pop all temps return ; and exit .save .psect $Pdata,d junkch: .byte 13.,10.,12.,27.,0,0 .restore .dsabl lsb .sbttl l$len get length of .asciz string ; L $ L E N ; ; input: r0 = address of .asciz string ; output: r0 = length of it l$len:: mov r0 ,-(sp) ; save it for later. 10$: tstb (r0)+ ; look for a null character. bne 10$ ; keep going sub (sp)+ ,r0 ; subtract start address from dec r0 ; current pointer less 1. return .sbttl write decimal l$wrdec:: dfwidth = 6 ; ; write a decimal number to KB: passed at 0(r5) ; ; save <r1,r4,r5> mov 2(r5) ,r1 ; field width bgt 10$ ; good positive value. beq 5$ ; zero, make it 6. neg r1 ; negative means no space fill br 10$ ; and skip this 5$: mov #dfwidth,r1 ; finally, we have the width. 10$: mov r1 ,r4 ; save for a moment add #5 ,r1 ; make it round up to even num. bic #1 ,r1 ; at last.... mov 2(r5) ,-(sp) ; The real field width please. mov @r5 ,-(sp) ; And the number to print out. mov sp ,r5 ; setup the parameter list addr tst -(r5) ; make room for the buffer on sub r1 ,sp ; the stack. mov sp ,@r5 ; insert the buffer address call l$cvtnum ; and convert the number. .print @r5 ,r4 ; and print it out add r1 ,sp ; and fix the stack up. cmp (sp)+ ,(sp)+ ; rest of stack pop. unsave <r5,r4,r1> ; thats all for now return ; write out a decimal number at 2(r5) into the buffer ; address passed at 0(r5). All registers saved. l$cvti::save <r5> ; call common conversion sub. clr -(sp) ; setup paramter list first. mov 2(r5) ,-(sp) ; calls $cvtnum,<@r5,2(r5),#0> mov @r5 ,-(sp) ; finally the buffer address. mov sp ,r5 ; the parameter list address. call l$cvtnum ; convert it please. add #6 ,sp ; pop stack parameter list. unsave <r5> ; restore r5 return ; and exit please. .sbttl the real conversion sub ; input: 0(r5) = buffer address ; 2(r5) = value to print ; 4(r5) = field width ( > 0 ->right, < 0 -> left ) ; ; field width: if < zero, string will be left justified ; if > zero, string will be right justified ; if = zero, field will be set to 6. ; l$cvtnum:: save <r0,r1,r2,r3,r4> ; some scratch registers saved mov (r5) ,r2 ; the buffer address to use. mov 4(r5) ,r3 ; the field width to use. bgt 80$ ; nonzero, it is ok (?) beq 70$ ; zero neg r3 ; < 0 br 80$ 70$: mov #dfwidth,r3 ; zero, use default width 6. 80$: mov r3 ,r1 ; put it here to clear buffer. 1$: movb #32. ,(r2)+ ; fill the buffer with blanks sob r1 ,1$ mov r2 ,-(sp) ; save end of buffer here. mov r3 ,r4 ; save buffer size also. mov 2(r5) ,r1 ; Get the value to print out. bpl 2$ neg r1 2$: clr r0 ; set up for the divide by 10. div #10. ,r0 ; remainder in r1, quotient r0 add #'0 ,r1 ; convert remainder to character cmp r2 ,@r5 ; overflowed the buffer at all? beq 100$ ; yes, get out of here ! movb r1 ,-(r2) ; and return the character now. mov r0 ,r1 beq 3$ sob r3 ,2$ ; go back for more tst r1 ; something left over by chance? bne 100$ ; Yes, that's a definite error. 3$: tst 2(r5) ; was this a negative number ? bpl 90$ ; no, exit cmp r2 ,@r5 ; yes, room left for a '-' sym. beq 100$ ; no, flag an error please. movb #'- ,-(r2) ; yes, insert a minus symbol. ;; br 90$ ; thats all. 90$: tst 4(r5) ; negative field width ? bpl 4$ ; no, exit. mov @r5 ,r1 ; start of the buffer here. 95$: movb (r2)+ ,(r1)+ ; move chars to front of buffer. cmp r2 ,(sp) ; end of the buffer yet ? bhis 97$ ; no, keep going please. sob r4 ,95$ ; keep going please 97$: dec r4 ; anything left to zero out? ble 4$ ; no 98$: movb #40 ,(r1)+ ; yes, zero to end of buffer. sob r4 ,98$ ; more please br 4$ ; finally exit this mess. 100$: movb #'* ,@r2 ; field overlfow. place '*' in ; beginning of the buffer. 4$: tst (sp)+ ; pop stack, restore temp regs unsave <r4,r3,r2,r1,r0> return ; thats all there is to it. .sbttl mout print text from message macro locmout:: tst remote beq mout mov (sp)+ ,@sp return mout:: save <r0> mov 4(sp) ,r0 .print r0 unsave <r0> mov (sp)+ ,@sp return .sbttl instr ; I N S T R simple (non-wildcard) version ; input: ; ; (r5) = address of the first string ; 2(r5) = length of the first string . ; 4(r5) = address of the second string, the one to find. ; 6(r5) = length of the second string. ; ; output: ; ; r0 = if > 0 then r0=position of second in first ; else the second is not a substring. ; instr:: save <r1,r2,r3,r4> ; we use these here, so save. mov (r5) ,r0 ; the address of first string mov 4(r5) ,r1 ; the address of second one. mov 6(r5) ,r2 ; the length of second one. ble 6$ ; a null string ? mov 2(r5) ,r4 ; the length of first. ble 6$ ; a null string ? sub r2 ,r4 ; convert to looping counter clr r3 ; the real loop counter. 1$: cmp r3 ,r4 ; are we done yet ? bgt 6$ ; yes, if r3 > r4 . cmpb (r0)+ ,(r1) ; see if current character in bne 5$ ; matches first one in second. save <r0,r1,r2> ; found first character match. inc r1 ; point to the next character dec r2 ; length of pattern thats left ble 3$ ; in case the len( pattern ) =1 2$: cmpb (r0)+ , (r1)+ ; check the rest of the pattern bne 4$ sob r2 ,2$ ; loop for len( pattern ) - 1 3$: mov r3 ,r0 ; the current loop count inc r0 add #6 ,sp ; fix the stack from save < > br 7$ 4$: unsave <r2,r1,r0> ; the match failed. restore the 5$: inc r3 ; pointers and go try the next br 1$ ; character in the first string 6$: clr r0 ; complete failure if get here 7$: unsave <r4,r3,r2,r1> ; restore the registers we used return ; and go away. .sbttl convert rad50 word to 3 ascii bytes and back ;rdtoa ; (r5) = address of where to put ascii chars ; input 2(r5) = the value of rad 50 word ; ; ; ;procedure rd_toa( rval: integer ; var aout: array [1..3] of char ) ; ; ; type rlist = array [0..39] of char ; ; const ; r50ch = rlist(' ','A','B','C','D','E','F','G','H','I','J','K', ; 'L','M','N','O','P','Q','R','S','T','U','V','W', ; 'X','Y','Z','$','.','?','0','1','2','3','4','5', ; '6','7','8','9' ); ; var i: integer ; ; begin ; aout[1] := r50ch[ rval div 3100B ]; rval := rval mod 3100B ; ; aout[2] := r50ch[ rval div 50B ] ; aout[3] := r50ch[ rval mod 50B ] ; end ; rdtoa:: radasc: save <r0,r1,r3> ; same some registers mov 2(r5) ,r1 ; go get the rad50 character. mov (r5) ,r3 ; where to put the characters. com: clr r0 ; prepare for divide div #3100 ,r0 ; get first char movb radchr(r0),(r3)+ ; put in buffer clr r0 ; another divide div #50 ,r0 ; this one gives char 2 movb radchr(r0),(r3)+ ; put this in buffer movb radchr(r1),(r3)+ ; and also char 3 unsave <r3,r1,r0> ; restore the registers we used. return ; bye .save .psect $Pdata,d .nlist bex radchr: .ascii / ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:/ .list bex .even .restore .sbttl get decimal number value ; L $ V A L (20-Nov-80) ; ; (r5) = address of .asciz string to convert ; ; r0 = error (-1 for bad number) ; r1 == binary value of the string. l$val:: save <r2,r3> clr r1 ; initailize the result. mov (r5) ,r3 ; the address of the string. clr -(sp) ; a positive number for now. clr r0 30$: tstb @r3 ; null. If so, exit please. beq 5$ ; buy. cmpb @r3 ,#space ; we will ignore spaces. beq 50$ ; if equal, then skip. tst r0 ; past the first space yet ? bne 40$ ; yes, skip sign checks. com r0 ; past all the leading spaces. cmpb @r3 ,#'+ ; positive number ? beq 50$ ; yes, skip over the character. cmpb @r3 ,#'- ; negative ? bne 40$ ; no, try for a digit then. mov sp ,(sp) ; neg, set a useful flag up. br 50$ ; and skip it. 40$: cmpb @r3 ,#'0 ; try comparing to '0' . blo 70$ ; not a digit. time to go cmpb @r3 ,#'9 ; try comparing to '9' . bhi 70$ ; not a digit . get out. clr -(sp) ; clr out the scratch reg. bisb @r3 ,(sp) ; copy the character over. sub #48. ,(sp) ; convert char to a digit. mul #10. ,r1 ; multiply accum by 10 first bcs 60$ ; oops add (sp)+ ,r1 ; add on the digit to accum bvs 70$ ; bye 50$: inc r3 ; pointer := succ( pointer ); br 30$ 60$: tst (sp)+ ; came here from multiply overf 70$: clr r0 ; return 0 in case of error. mov #-1 ,r0 ; ?Illegal number tst (sp)+ ; pop sign flag from stack. br 100$ 5$: tst (sp)+ ; pop sign flag on tos. beq 95$ ; positive number ? tst r1 ; negative 0 (-32768) ? bne 90$ ; no bis #100000 ,r1 ; yes, set only the sign bit br 95$ ; and go away. 90$: neg r1 ; no. 95$: clr r0 100$: unsave <r3,r2> return ; and time to leave. .sbttl octval return octal vaule in r1, error in r0 octval::save <r2,r3> ; save temps please clr r0 ; assume no error clr r1 ; value := 0 mov @r5 ,r2 ; get the buffer address 10$: movb (r2)+ ,r3 ; get the next character please beq 100$ ; all done cmpb r3 ,#'0 ; error if < '0' or > '7' blo 90$ ; oops cmpb r3 ,#'7 ; how about the upper limit bhi 90$ ; oops sub #'0 ,r3 ; get the value asl r1 ; accumulated value times 8 asl r1 ; the long way asl r1 ; r1 = r1 * 8 add r3 ,r1 ; add in the current digit br 10$ ; next 90$: mov #-1 ,r0 ; illegal number 100$: unsave <r3,r2> ; pop registers and exit return .sbttl binary to octal conversion .enabl lsb ; ; 17-Nov-80 BDN ; ; convert binary number at 2(r5) to ascii string ; at buffer address 0(r5). ; l$otoa::save <r0,r1,r2,r3> ; save the scratch regs. mov (r5) ,r2 mov 2(r5) ,r3 add #6 ,r2 ; do it backwards mov #6 ,r0 ; do it 6 times 10$: mov r3 ,r1 ; get the number bic #177770 ,r1 ; leave low order 3 bits on movb 200$(r1),-(r2) ; move an octal digit ash #-3 ,r3 ; shift three bytes bic #160000 ,r3 ; zap propagated sign bits sob r0 ,10$ ; go convert next digit unsave <r3,r2,r1,r0> return .save .psect $Pdata,D 200$: .ascii \01234567\ ; ascii/octal 200$ .even .restore .dsabl lsb ; (r5) = value to write to KB: l$wroc::save <r0> sub #10 ,sp mov sp ,r0 ; use stack for a buffer calls l$otoa ,<r0,(r5)> print r0 ,#6. add #10 ,sp unsave <r0> return .sbttl copyz copyz .asciz string ; C O P Y Z $ ; ; input: 6(sp) max len or zero ; 4(sp) source string address ; 2(sp) destination string address ; ; usage: copyz macro, as in copyz #oldfile,#newfile copyz$::save <r0,r1> ; save registers we may use tst 4+6(sp) ; see if a maxlen was passed bne 5$ ; yes mov #77777 ,4+6(sp) ; no, say we can have MAXINT chars 5$: mov 4+4(sp) ,r0 ; source string address mov 4+2(sp) ,r1 ; destination string address 10$: movb (r0)+ ,(r1)+ ; copy a byte beq 20$ ; until a null is found dec 4+6(sp) ; or we have copied MAXLEN number bne 10$ ; of characters over 20$: clrb -(r1) ; insure output .asciz please unsave <r1,r0> ; pop temps mov @sp ,6(sp) ; move return address up add #6 ,sp ; fix the stack return ; and exit .sbttl formatted byte dump ; input: 4(sp) size ; 2(sp) address dump$b::save <r0,r1,r2> ; save all please mov <4+6>(sp),r1 ; size beq 100$ ; nothing do to today mov <2+6>(sp),r2 ; address to dump 10$: clr r0 ; get the next byte please bisb (r2)+ ,r0 ; get it decout r0 ; and print it sob r1 ,10$ ; next please 100$: .newline ; a cr/lf unsave <r2,r1,r0> ; pop all registers we used mov @sp ,4(sp) ; move return address up cmp (sp)+ ,(sp)+ ; pop two words for parameter list return ; and exit .sbttl strcat and strcpy ; input: ; 0(sp) return address ; 2(sp) dst address ; 4(sp) src address ; output: r0 dest address strcpy::save <r1> ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address unsave <r1> ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return strcat::save <r1> ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 5$: tstb (r0)+ ; look for the end of the dst string bne 5$ ; not found yet dec r0 ; found it, fix the pointer 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address unsave <r1> ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return strcmp::mov 2(sp),r0 ;Pick up 'a' mov 4(sp),r1 ;And 'b' 10$: cmpb (r0)+,(r1) ;Are they the same bne 20$ ;No tstb (r1)+ ;At the end of the string bne 10$ ;No clr r0 ;Equal return br 100$ 20$: blo 30$ ;Br if a<b mov #1,r0 ;A>b return br 100$ 30$: mov #-1,r0 ;A<b return 100$: mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return malloc::inc r0 bic #1 ,r0 mov r0 ,-(sp) add @albuff ,(sp) cmp (sp) ,#alsize bhis 90$ mov albuff ,r0 add #2 ,r0 add @albuff ,r0 mov (sp)+ ,@albuff return 90$: clr r0 tst (sp)+ return global <albuff,alsize> decryp:: encryp::mov (sp) ,4(sp) cmp (sp)+ ,(sp)+ return .end